# user list: send it a message. either type chat with a body of NAMES or a normal message with a subject of IrcUserList


# Single Threaded Simplistic Site
lappend auto_path c:/Users/decoster/Documents/TclTk/www/wub
lappend auto_path /target/staff/decoster/tmp/tml/www/Wub-trunk

lappend auto_path /home/jdc/wubchain_suspend/lib/tclxmppd
lappend auto_path c:/Users/decoster/Documents/TclTk/www/tclxmppd
lappend auto_path /target/staff/decoster/tmp/tml/www/tclxmppd

#lappend auto_path /var/www/Wub ;# path to the Site.tcl file
lappend auto_path /home/jdc/wub
lappend auto_path . lib

set docroot [pwd]/docroot
set home $docroot
set wubchainDb [pwd]/docs/wubchain.tkd

set connectToJabber 1 

package require Site
package require http
package require Mk4tcl
package require component

###### Application Starts Here
#### install directories of static files
foreach {dom expiry} {css {tomorrow} images {next week} scripts {next week} img {next week} html 0} {
    File $dom -root [file join $docroot $dom] -expires $expiry
}

#### Honeypot domain captures misbehaving bots
package require Honeypot
set hp [file join /tmp/ captcha]
catch {file mkdir $hp}
Honeypot init dir $hp honeypot /bzzzz captcha /captcha

#### robots: sent as robots.txt
variable robots {User-agent: *
    Disallow: /bzzzz
}

# sortable - include javascripts and CSS for sortable table.
proc sortable {r} {
    foreach js {common css standardista-table-sorting} {
	dict lappend r -headers [<script> type text/javascript src /$js.js {}]
    }
    dict lappend r -headers [<style> type text/css media all "@import url(/sorttable.css);"]
    return $r
}

#### introspection: example of a direct domain
# used to introspect the server
namespace eval ::Introspect {
    # clear the cache
    proc /cclear {r args} {
	Cache clear
	return [Http Redir $r /]
    }

    # report on the cache
    proc /cache {r args} {
	dict lappend r -headers [<title> "Wubchain introspect: cache"]
	set C [Html dict2table [Cache::2dict] {-url -stale -hits -unmod -ifmod -when -size}]
	return [Http NoCache [Http Ok [sortable $r] $C x-text/html-fragment]]
    }

    # report on currently blocked client sites
    proc /block {r args} {
	dict lappend r -headers [<title> "Wubchain introspect: blocked clients"]
	set C [Html dict2table [Block blockdict] {-site -when -why}]
	return [Http NoCache [Http Ok [sortable $r] $C x-text/html-fragment]]
    }

    proc /state {r} {
	dict lappend r -headers [<title> "Wubchain introspect: state"]
	set state [Activity state]
	set result [<table> summary {} class sortable [subst {
	    [<thead> [<tr> [<th> [join {cid socket thread backend ip start end log} </th><th>]]]]
	    [<tfoot> [<tr> [<th> [join {cid socket thread backend ip start end log} </th><th>]]]]
	    [<tbody> [Foreach row $state {
		[<tr> [<td> [join $row </td><td>]]]
	    }]]
	}]]
	
	set r [sortable $r]	;# include the sortable js
	
	return [Http NoCache [Http Ok $r $result]]
    }

    proc /activity {r SID {L "current"} {F "html"}} {
	if {[catch {::Wubchain::check_sid r $SID} d]} { return $r }
	# generate an activity page
	if {$L eq "log"} {
	    set act [Activity log]
	    set title "Wubchain introspection: activity log"
	    set alt [<a> href "/introspect/activity?L=current" "Current server activity:"]
	} else {
	    set act [Activity current]
	    set title "Wubchain introspection: current activity"
	    set alt [<a> href "/introspect/activity?L=log" "Server activity Log"]
	}

	switch -- $F {
	    csv {
		package require csv
		foreach a $act {
		    append result [::csv::joinlist $a] \n
		}
		dict set r content-type text/plain
	    }

	    html -
	    default {
		set table [<table> summary {} class sortable [subst {
		    [<thead> [<tr> [Foreach t [lindex $act 0] {
			[<th> [string totitle $t]]
		    }]]]
		    [<tfoot> [<tr> [Foreach t [lindex $act 0] {
			[<th> [string totitle $t]]
		    }]]]
		    [<tbody> [Foreach a [lrange $act 1 end] {
			[<tr> class [If {[incr row] % 2} even else odd] \
			     [<td> [join $a </td>\n<td>]]]
		    }]]
		}]]
		set result "[<h1> $title]$table[<p> $alt]"
		
		set r [sortable $r]	;# include the sortable js
		dict set r content-type x-text/html-fragment
	    }
	}
	
	return [Http NoCache [Http Ok $r $result]]
    }

    proc /chat_activity { r SID } {
	if {[catch {::Wubchain::check_sid r $SID} d]} { return $r }
	dict lappend r -headers [<title> "Wubchain introspection: chat activity"]
	foreach {k v} [array get ::Wubchain::stats] {
	    dict set d parameter $k
	    dict set d value $v
	    dict set td [incr i] $d
	}
	foreach {k v} [array get ::Wubchain::stats] {
	    dict set d parameter $k
	    dict set d value $v
	    dict set td [incr i] $d
	}
	set C [Html dict2table $td {parameter value}]
	return [Http NoCache [Http Ok [sortable $r] $C x-text/html-fragment]]
    }

    proc /parameters { r SID } { 
	if {[catch {::Wubchain::check_sid r $SID} d]} { return $r }
	dict lappend r -headers [<title> "Wubchain introspection: parameters"]
	foreach v [info vars ::Wubchain::wubchain_*] {
	    if {[info exists $v]} {
		upvar #0 $v p
		dict set d parameter [armour $v]
		dict set d value [armour $p]
		dict set td [incr i] $d
	    }
	}
	set C [Html dict2table $td {parameter value}]
	return [Http NoCache [Http Ok [sortable $r] $C x-text/html-fragment]]
    }

    proc /users { r SID } {
	if {[catch {::Wubchain::check_sid r $SID} d]} { return $r }
	dict lappend r -headers [<title> "Wubchain introspect: users"]
	set C [<h2> "Users currently logged in:"]
	foreach ud [::Wubchain::dbUsers] {
	    dict set d username [dict get $ud username]
	    dict set td [incr i] $d
	}
	if {[info exists td]} {
	    append C [Html dict2table $td {username}]
	    unset td
	} else {
	    append C "No logged-in users."
	}
	append C [<h2> "User currently suspended:"]
	if {[llength $::Wubchain::suspended]} {
	    foreach {sr TS SID ID MSG} $::Wubchain::suspended {
		set ud [Wubchain::dbLoadUser sid $SID]
		if {[string length $SID] && [dict exists $ud username]} {
		    dict set d username [dict get $ud username]
		    dict set td [incr i] $d
		}
	    }
	}
	if {[info exists td]} {
	    append C [Html dict2table $td {username}]
	} else {
	    append C "No suspended users."
	}
	return [Http NoCache [Http Ok [sortable $r] $C x-text/html-fragment]]
    }

    proc /overview { r SID } {
	if {[catch {::Wubchain::check_sid r $SID} d]} { return $r }
	dict lappend r -headers [<title> "Wubchain introspection: overview"]
	set C ""
	append C [<h1> "Wubchain introspection:"]
	append C <ul>
	append C [<li> [<a> href /introspect/activity?SID=$SID "Server activity"]]
	append C [<li> [<a> href /introspect/block?SID=$SID "Blocked clients"]]
	append C [<li> [<a> href /introspect/cache?SID=$SID Cache]]
	append C [<li> [<a> href /introspect/chat_activity?SID=$SID "Chat activity"]]
	append C [<li> [<a> href /introspect/parameters?SID=$SID Parameters]]
	append C [<li> [<a> href /introspect/state?SID=$SID State]]
	append C [<li> [<a> href /introspect/users?SID=$SID Users]]
	append C [<li> [<a> href /wubchain/get?SID=$SID "Back to chat"]]
	append C </ul>
	return [Http Ok $r $C x-text/html-fragment]
    }

    proc / { r SID } { 
	return [/overview $r $SID]
    }

    namespace export -clear {*}
    namespace ensemble create -subcommands {}
}

Direct init introspect namespace ::Introspect prefix /introspect/ ctype "x-text/html-fragment"

namespace eval ::Wubchain {

    variable wubchain_nposts 1000 ;# Number of posts to keep
    variable wubchain_sys_nick_list {- tcl@tach.tclers.tk} ;# Do not regard messages from these users as new posts
    variable wubchain_bridge_nick_list {azbridge ijchain wubchain webchain }
    variable wubchain_check_delay 5 ;# in seconds
    variable wubchain_suspend_timeout 90 ;# in seconds

    variable wubchain_nick_css_url http://tkchat.tcl.tk/usercolors.css 
    variable wubchain_nick_css_update_interval 3600 ;# in seconds
    variable wubchain_nick_css_list {}
    variable wubchain_admin "jos_dot_decoster_at_gmail_dot_com"

    variable logid 0
    variable log
    variable irc_users
    variable jabber_users
    variable stats
    variable suspended {}

    set stats(posts_from_jabber) 0
    set stats(posts_from_wubchain) 0
    set stats(gets_from_wubchain) 0
    set stats(last_post_time_stamp) 0

    variable htmlhead {<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1.dtd">}
    variable language "en"
    
    variable mobile_head {
	<style type='text/css' media='all'>@import url(/wubchain_mobile.css);</style>
    }
    
    variable full_head {
	<style type='text/css' media='all'>@import url(/wubchain_full.css);</style>
	<style type='text/css' media='all'>@import url(/tooltips.css);</style>
    }

    variable head {
	<style type='text/css' media='all'>@import url(/wubchain.css);</style>
	<style type='text/css' media='all'>@import url(/wubchain_nick.css);</style>
    }
    
    variable jscripts {
	<script src='/check_new.js' type='text/javascript'></script>
	<script src='/selection.js' type='text/javascript'></script>
	<script src='/tooltips.js' type='text/javascript'></script>
    }
    
    proc SmileId { name n triggers } {
	variable IMG
	variable IMGre
	foreach arg $triggers {
	    set IMG($arg) $name
	    if { [string is alnum -strict -failindex i $arg] } {
		lappend ids "\1$arg\2"
	    } elseif { [string is alnum -strict [string index $arg end]] } {
		if {$i > 0} {
		    lappend ids "\1$arg\2"
		} else {
		    lappend ids "\3$arg\2"
		}
	    } else {
		if {$i > 0} {
		    lappend ids "\1$arg"
		} else {
		    lappend ids "\3$arg"
		}
	    }
	}
	set ids [join $ids "\0"]
	set map [list \
		     |   \\|		(   \\(		)   \\)		\[   \\\[	\
		     -   \\-		.   \\.		*   \\*		?    \\?	\
		     \\  \\\\	^   \\^		$   \\$		\1   \\m	\
		     \2  \\M		\3  \\Y		\0  |				\
		    ]
	# If we ever change this to use () capturing, change tkchat::Insert too.
	if { [info exists IMGre] } {
	    append IMGre |[string map $map $ids]
	} else {
	    set IMGre [string map $map $ids]
	}
    }

    SmileId cry 1 {":-(" ":^(" ":("}
    SmileId grrr 1 {"8-(" "8^(" "8(" "8-|" "8^|" "8|"}
    SmileId LOL-anim 1 {LOL lol}
    SmileId mad 1 {">:(" ">:-(" ">:^("}
    SmileId oh 1 {":-o" ":^o" ":o" ":-O" ":^O" ":O"}
    SmileId smile 1 {":-)" ":^)" ":)"}
    SmileId smile-big 1 {":-D" ":^D" ":D"}
    SmileId smile-dork 1 {"<:-)" "<:^)" "<:)"}
    SmileId smile-glasses 1 {"8-)" "8^)" "8)"}
    SmileId smile-tongue-anim 1 {":-p" ":^p" ":p"}
    SmileId smirk-glasses 1 {";/" ";-/" ";^/" ":/" ":-/" ":^/" "8/" "8-/" "8^/"}
    SmileId tongue2 1 {":-P" ":^P" ":P"}
    SmileId updown 1 {"(:" "(^:" "(-:"}
    SmileId wink-anim 1 {";-)" ";^)" ";)"}
    SmileId blush 1 {":-\}" ":^\}" ":8\}" ":\}"}
    SmileId coffee 1 LP
    SmileId lunch 1 {|O| |o| |0|}
    SmileId snooze 1 {zz zzz zzZ zZZ ZZZ ZZ}
    SmileId beer 1 "|_P"
    SmileId cyclops 1 {"O-\]" "O-)" "0-\]" "0-)"}    
    SmileId donuts 1 "donuts"
    SmileId bug 1 {"bug #" "bug#"}
    SmileId wave 2 {~~~ waves}
    SmileId phone 3 {"on the phone"}
    SmileId yawn 3 {yawn yawns}
    SmileId applause 2 {applause applauds}
    SmileId duck 1 {"\\_o<" "\\_O<" "\\_0<" ">o_/" ">O_/" ">0_/" "\\_o=" "\\_O=" "\\_0=" "=o_/" "=O_/" "=0_/" duck ducks}

    proc create_nick_css { } {
	variable wubchain_nick_css_url
	variable wubchain_nick_css_list {}
	if {[string length $wubchain_nick_css_url] == 0} {
	    return
	}

	if {[catch {http::geturl $wubchain_nick_css_url} tkn]} {
	    Debug.error {create_nick_css: $tkn}
	    return
	}
	
	if {[http::ncode $tkn] == 200} {
	    set wubchain_nick_css ""
	    set ll {}
	    foreach l [split [http::data $tkn] \n] {
		if { [regexp {^span\.(\w+)\s+\{\s*color:\s*(#[[:xdigit:]]+)\s*;\s*\}$} $l m nick color] } {
		    lappend wubchain_nick_css_list [list $nick $color]
		    lappend ll $l
		}
	    }

	    append wubchain_nick_css [join $ll \n]
	}
	set f [open $::docroot/css/wubchain_nick.css w]
	puts $f $wubchain_nick_css
	close $f
	http::cleanup $tkn
    }

    proc m { mt mn mm {pn ""} {type groupchat}} {
	variable log
	variable logid
	variable wubchain_bridge_nick_list
	variable current_log_NICK
	set logonoff 0

	set mm [encoding convertfrom utf-8 $mm]
	set mn [encoding convertfrom utf-8 $mn]

	if {![string length $mn] || [in $wubchain_bridge_nick_list $mn]} {
	    if {[regexp {<([^>]+)>(.+)} $mm -> tmn tmm]} {
		set mn $tmn
		set mm $tmm
	    } elseif {[regexp {^\*+ ([^ ]+) joins$} $mm -> tmn tmm]} {
		set mn $tmn
		set mm "/me joins"
		set logonoff 1
	    } elseif {[regexp {^([^ ]+) has become available$} $mm -> tmn tmm]} {
		set mn $tmn
		set mm "/me joins"
		set logonoff 1
	    } elseif {[regexp {^\*+ ([^ ]+) leaves$} $mm -> tmn tmm]} {
		set mn $tmn
		set mm "/me leaves"
		set logonoff 1
	    } elseif {[regexp {^([^ ]+) has left$} $mm -> tmn tmm]} {
		set mn $tmn
		set mm "/me leaves"
		set logonoff 1
	    } elseif {[regexp {\* ([^ ]+) (.+)} $mm -> tmn tmm]} {
		set mn $tmn
		set mm "/me $tmm"
	    }
	}
	if {[regexp {^/[Mm][Ee] (.+)} $mm -> mm]} {
	    set prep <i>
	    set postp </i>
	    set emote 1
	} else {
	    set prep ""
	    set postp ""
	    set emote 0
	}
	set amm {}
	set amm {}
	foreach l [split $mm \n] {
	    lappend amm "$prep[armour $l]$postp<br />"
	    lappend hmm "$prep[hfrmt $l]$postp<br />"
	}
	# subtract 4 hours from history timestamp to correct time diff between history (in gmt) and server (somewhere in USA)
	lappend log([prep_username $current_log_NICK]) [incr logid] [expr {[clock scan $mt -format {%Y-%m-%dT%H:%M:%SZ}]-3600*4}] [armour $mn] $pn $mm [join $amm] [join $hmm] $emote $logonoff $type
    }

    proc load_history { NICK } {
	variable log
	variable wubchain_nposts
	variable current_log_NICK $NICK
	foreach t {yesterday today} {
	    set url "http://tclers.tk/conferences/tcl/[clock format [clock scan $t] -format {%Y-%m-%d}].tcl"
	    puts "loading history from $url for $NICK"
	    if {[catch {http::geturl $url} tkn]} {
		Debug.error {create_nick_css: $tkn}
		continue
	    }
	    if {[http::ncode $tkn] == 200} {
		eval [http::data $tkn]
	    }
	    http::cleanup $tkn
	}
	# add 4 hours because proc m adjusts time diff between history and server
	m [clock format [expr {[clock seconds]+3600*4}] -format {%Y-%m-%dT%H:%M:%SZ}] "" "<<<<<<<<<< End of history" $NICK chat
	set log([prep_username $NICK]) [lrange $log([prep_username $NICK]) end-[expr {$wubchain_nposts*10-1}] end]
	unset current_log_NICK
    }
    
    proc make_href {url} {
	return [<a> href [armour $url] target _blank [armour $url]]
    }
    
    proc make_tipref {tip} {
	regexp {\s*/?[Tt][Ii][Pp]\s*(\d+)} $tip -> ntip
	return [<a> href http://www.tcl.tk/cgi-bin/tct/tip/$ntip target _blank "$tip"]
    }
    
    proc make_sfbugref {id} {
	return [<a> href http://sourceforge.net/support/tracker.php?aid=$id target _blank $id]
    }

    proc make_iref {emo} {
	variable IMG
	return "<img src='/$IMG($emo).gif' alt='[armour $emo]' />"
    }

    proc sfrmt {msg} {
	variable IMGre
	set i 0
	set hmsg ""
	foreach match [regexp -inline -all -indices -- $IMGre $msg] {
	    lassign $match start end
	    set emo [string range $msg $start $end]
	    append hmsg [armour [string range $msg $i [expr {$start-1}]]]
	    append hmsg [make_iref $emo]
	    set i [expr {$end+1}]
	}	
	if { $i <= [string length $msg] } {
	    append hmsg [armour [string range $msg $i end]]
	}
	return $hmsg
    }

    proc hfrmt {msg} {
	# url's
	set i 0
	set n 0
	set hmsg {}
	foreach match [regexp -inline -all -indices -- {(https?|ftp|news|mailto|file):([^\s:]\S*[^\]\)\s\.,!\?;:'>"])} $msg] { ;# "
	    if { $n % 3 == 0 } {
		lassign $match start end
		set url [string range $msg $start $end]
		lappend hmsg 0 [string range $msg $i [expr {$start-1}]]
		lappend hmsg 1 [make_href $url]
		set i [expr {$end+1}]
	    }
	    incr n
        }
	if { $i <= [string length $msg] } {
	    lappend hmsg 0 [string range $msg $i end]
	}
        # tips										       
        set tmsg {}
	foreach {mod txt} $hmsg {
	    if {$mod} {
		lappend tmsg 1 $txt
	    } else {
		set i 0
		set n 0
		foreach match [regexp -inline -all -indices -- {/?[tT][Ii][Pp]\s*(\d+)} $txt] {
		    if { $n % 2 == 0 } {
			lassign $match start end
			set tip [string range $txt $start $end]
			lappend tmsg 0 [string range $txt $i [expr {$start-1}]]
			lappend tmsg 1 [make_tipref $tip]
			set i [expr {$end+1}]
		    }
		    incr n
		}
		if { $i <= [string length $txt] } {
		    lappend tmsg 0 [string range $txt $i end]
		}
	    }
	}
        # SF bugs (6 or 7 digits)
        set bmsg {}
	foreach {mod txt} $tmsg {
	    if {$mod} {
		lappend bmsg 1 $txt
	    } else {
		set i 0
		set n 0
		foreach match [regexp -inline -all -indices -- {(\d{6,7})} $txt] {
		    if { $n % 2 == 0 } {
			lassign $match start end
			set tip [string range $txt $start $end]
			lappend bmsg 0 [string range $txt $i [expr {$start-1}]]
			lappend bmsg 1 [make_sfbugref $tip]
			set i [expr {$end+1}]
		    }
		    incr n
		}
		if { $i <= [string length $txt] } {
		    lappend bmsg 0 [string range $txt $i end]
		}
	    }
	}
        # emoticons
	set rmsg {}
	foreach {mod txt} $bmsg {
	    if {$mod} {
		lappend rmsg $txt
	    } else {
		lappend rmsg [sfrmt $txt]
	    }
	}
	return [join $rmsg]
    }

    proc prep_username {u} {
	return [string tolower $u]
    }

    proc in {list element} {
	expr {[lsearch -exact $list $element]>=0}
    }

    proc jabber_enter { nick mode } {
	variable jabber_users
	set jabber_users($nick) $mode
    }

    proc jabber_leave { nick } {
	variable jabber_users
	set jabber_users($nick) offline
    }

    proc jabber_to_wub {nick msg priv type} {
	variable log
	variable logid
	variable irc_fd
	variable stats
	variable wubchain_sys_nick_list
	variable wubchain_bridge_nick_list
	variable irc_users

	set emote 0
	if {[regexp {^/[Mm][Ee] (.+)} $msg -> action]} {
	    set emote 1
	    set msg $action
	}

	set logonoff 0

#	puts "j2w: $nick, $msg, $priv, $type"

	if {$nick eq "ijchain" && $type eq "chat"} {
	    foreach n $msg {
		set irc_users($n) 1
	    }
	} else {
	    if {![string length $nick] || [in $wubchain_bridge_nick_list $nick]} {
		if {[regexp {<([^>]+)>(.+)} $msg -> nick msg]} {
		} elseif {[regexp {^\*+ ([^ ]+) joins$} $msg -> nick tmm]} {
		    set msg "joins"
		    set logonoff 1
		    set irc_users($nick) 1
		} elseif {[regexp {^([^ ]+) has become available$} $msg -> nick tmm]} {
		    set msg "joins"
		    set logonoff 1
		} elseif {[regexp {^\*+ ([^ ]+) leaves$} $msg -> nick tmm]} {
		    set msg "leaves"
		    set logonoff 1
		    set irc_users($nick) 0
		} elseif {[regexp {^([^ ]+) has left$} $msg -> nick tmm]} {
		    set msg "leaves"
		    set logonoff 1
		}
	    }
	    
	    #	puts "\n\n\nj2w nick=$nick msg=$msg priv=$priv type=$type\n\n\n"
	    
	    lappend log([prep_username $priv]) [incr logid] [clock seconds] [armour $nick] [armour $priv]
	    set pmsg {}
	    set gmsg {}
	    foreach msgl [split $msg "\n"] {
		if {$emote} {
		    lappend pmsg <i>[armour $msgl]</i>
		    lappend gmsg <i>[hfrmt $msgl]</i>
		} else {
		    lappend pmsg [armour $msgl] 
		    lappend gmsg [hfrmt $msgl]
		}
	    }
	    set plog [join $pmsg "<br />"]
	    append plog "<br />"
	    set glog [join $gmsg "<br />"]
	    append glog "<br />"
	    lappend log([prep_username $priv]) $msg $plog $glog $emote $logonoff $type
	    incr stats(posts_from_jabber)
	    if {![in $wubchain_sys_nick_list $nick]} { 
		set stats(last_post_time_stamp) [clock seconds]
	    }
	}
	resume_suspended
    }

    proc sendPage { r C focus innerHtml mobile } {
	variable htmlhead
	variable language
	variable mobile_head
	variable full_head
	variable head
	variable jscripts
	if { $innerHtml } {
	    set content $C
	} else {
	    set content "${htmlhead}\n"
	    append content "<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='$language' lang='$language'>" \n
	    append content <head> \n
	    if {[dict exists $r -headers]} {
		append content [join [dict get $r -headers] \n] \n
		dict unset r -headers
	    }
	    append content <title> Wubchain </title>
	    if {$mobile} {
		append content $mobile_head
	    } else {
		append content $full_head
	    }
	    append content $head
	    append content </head> \n
	    append content <body> \n
	    append content $C \n
	    if {!$mobile} {
		append content $jscripts
	    }
	    append content </body> \n
	    append content </html> \n
	}

	# Send the page
	set r [dict replace $r \
		   -content $content \
		   -raw 1 \
		   content-type text/html]
	set r [Http NoCache $r]
	set r [Http Ok $r]

	return $r
    }

    proc resume_suspended { {use_ts 0} } {
	variable suspended
	variable wubchain_suspend_timeout
	set tsuspended {}
	foreach {r TS SID ID MSG} $suspended {
	    if { !$use_ts || [expr {[clock seconds] - $TS}] > $wubchain_suspend_timeout } {
		Http Resume [/get $r $SID $ID $MSG 1]
	    } else {
		lappend tsuspended $r $TS $SID $ID $MSG
	    }
	}
	set suspended $tsuspended
    }

    proc select_lang { tag {selected ""} } {
	set ll {
	    en English 
	    ar Arabic
	    bg Bulgarian
	    zh-CN Chinese
	    hr Croatian
	    cs Czech
	    da Danish
	    nl Dutch
	    en English
	    fi Finnish
	    fr French
	    de German
	    el Greek
	    hi Hindi
	    it Italian
	    ja Japanese
	    ko Korean
	    no Norwegian
	    pl Polish
	    pt Portuguese
	    ro Romanian
	    ru Russian
	    es Spanish
	    sv Swedish
	}
	set txt "<select class='cmdinp' name='$tag'>"
	foreach {val lbl} $ll {
	    if {$selected eq $val} {
		append txt "<option value='$val' selected='selected'>$lbl</option>"
	    } else {
		append txt "<option value='$val'>$lbl</option>"
	    }
	}
	append txt "</select>"
    }

    proc select_TZ { tag {selected ""} } {
	variable tzdl
	set txt "<select name='$tag'>"
	foreach val $tzdl {
	    if {$val eq ""} continue
	    if {$selected eq $val} {
		append txt "<option value='$val' selected='selected'>$val</option>"
	    } else {
		append txt "<option value='$val'>$val</option>"
	    }
	}
	append txt "</select>"
    }

    proc control { name href img tip } {
	set R ""
	append R " <a class='cmdhref' href='$href' onmouseout='popUp(event,\"tip_$name\")' onmouseover='popUp(event,\"tip_$name\")'><img class='cmdimg' src='/$img' alt='$name' /></a>"
#	append R " <a class='cmdhref' href='$href' onmouseout='popUp(event,\"tip_$name\")' onmouseover='popUp(event,\"tip_$name\")' onclick='return false'><img class='cmdimg' src='/$img' alt='$name' /></a>"
	append R "<span id='tip_$name' class='tip'>$tip</span>"
	return $R
    }

    proc hform { r d sid msg update mobile } {
	variable logid
	variable wubchain_check_delay
	set R ""
	if {$mobile} {
	    append R "<form id='cpost' action='/wubchain/post' method='get'>"
	    append R "<input id='gobutton' type='submit' value='Go' />"
	    append R " <a href='/wubchain/getn?SID=$sid&amp;N=full'>F</a>"
	    append R " <a href='/wubchain/getn?SID=$sid&amp;N=20'>20</a>"
	    append R " <a href='/wubchain/settings?SID=$sid'>S</a>"
	    if {[dict get $d admin]} {
		append R " " [<a> href /wubchain/admin?SID=$sid "A"]
	    }
	    append R " "
	    append R "<input id='cmsg' name='MSG' value='[armour $msg]' />"
	    append R "<input id='cid' type='hidden' name='ID' value='$logid' />"
	    append R "<input id='sid' type='hidden' name='SID' value='$sid' />"
	    append R "</form>"
	} else {
	    append R "<div id='post_form'>"
	    append R "<form id='cpost' action='/wubchain/post' method='post'>"
	    append R "<input id='txtbutton' type='button' value='&gt;&gt;' onclick='multi_line()'/>"
	    append R "<span id='msgspan'><input id='cmsg' name='MSG' value='[armour $msg]' /></span>"
	    append R "<span id='txtspan'></span>"
	    append R "<br />"
	    append R "<input class='cmdinp' id='gobutton' type='submit' value='Post/Refresh' onmouseout='popUp(event,\"tip_post_refresh\")' onmouseover='popUp(event,\"tip_post_refresh\")' />"
	    append R "<span id='tip_post_refresh' class='tip'>Post message or refresh screen</span>"
	    append R " <a class='cmdhref' href='/wubchain/getn?SID=$sid&amp;N=full' onmouseout='popUp(event,\"tip_all\")' onmouseover='popUp(event,\"tip_all\")'>All</a>"
	    append R "<span id='tip_all' class='tip'>Load all messages</span>"
	    append R " <a class='cmdhref' href='/wubchain/getn?SID=$sid&amp;N=20' onmouseout='popUp(event,\"tip_20\")' onmouseover='popUp(event,\"tip_20\")'>20</a>"
	    append R "<span id='tip_20' class='tip'>Load 20 most recent messages</span>"
	    append R " <input class='cmdinp' id='searchbutton' type='button' value='Google' onclick='google_selection()' onmouseout='popUp(event,\"tip_google\")' onmouseover='popUp(event,\"tip_google\")'/>"
	    append R "<span id='tip_google' class='tip'>Google selection</span>"
	    append R "<input class='cmdinp' id='translatebutton' type='button' value='Translate' onclick='translate_selection()' onmouseout='popUp(event,\"tip_translate\")' onmouseover='popUp(event,\"tip_translate\")' /> from "
	    append R "<span id='tip_translate' class='tip'>Translate selection</span>"
	    append R [select_lang sl [dict get $d from_language]]
	    append R " to "
	    append R [select_lang tl [dict get $d to_language]]
	    append R [control settings "/wubchain/settings?SID=$sid"         wrench.png        "Edit settings"]
	    if {[dict get $d admin]} {
		append R [control admin   "/wubchain/admin?SID=$sid"         group_edit.png    "User administration"]
	    }
	    append R [control help     "/wubchain/help?SID=$sid"             information.png   "Help"]
	    append R [control online   "/wubchain/status?SID=$sid&ST=online" status_online.png "Set status to 'online'"]
	    append R [control away     "/wubchain/status?SID=$sid&ST=away"   status_away.png   "Set status to 'away'"]
	    append R [control xa       "/wubchain/status?SID=$sid&ST=xa"     status_xa.png     "Set status to 'extended away'"]
	    append R [control dnd      "/wubchain/status?SID=$sid&ST=dnd"    status_dnd.png    "Set status to 'do not disturb'"]
	    append R [control logout   "/wubchain/logout?SID=$sid"           cancel.png        "Log out"]
	    append R "<input id='cid' type='hidden' name='ID' value='$logid' />"
	    append R "<input id='sid' type='hidden' name='SID' value='$sid' />"
	    append R "</form>"
	    if {$update} {
		append R "<script type='text/javascript'>document.getElementById('cmsg').focus();</script>"
		append R "\n<script type='text/javascript'>setTimeout(\"check_new($logid,'[armour $sid]',[expr {$wubchain_check_delay*1000}])\",[expr {$wubchain_check_delay*1000}]);</script>" \n
	    }
	    append R "</div>"
	}
	return $R
    }
    
    proc unescape str {
#	set str [string map [list + { } "\\" "\\\\"] $str]
#	regsub -all -- {%([A-Fa-f0-9][A-Fa-f0-9])} $str {\\u00\1} str
#	set str [subst -novariable -nocommand $str]
	set str [encoding convertfrom utf-8 $str]
	string trim $str
    }

    proc /status { r SID ST } {
	if {[catch {check_sid r $SID} d]} { return $r }
	if {[lsearch {online away xa dnd} $ST] >= 0} {
	    ::/presence [dict get $d username] $ST ""
	}
	return [Http Redir $r "/wubchain/get#end" SID $SID]
    }

    proc /post { r SID ID MSG } {
	variable log
	variable logid
	variable stats
	variable wubchain_nposts
	variable irc_users

	if {[catch {check_sid r $SID} d]} { return $r }

	set NICK [dict get $d username]
	set MSG [unescape $MSG]

	if { ![string is integer -strict $ID] } { set ID 0 }
	set aNICK [armour $NICK]
	if { [string length $MSG] } {
	    set reason ""
	    if {[regexp {^\s*/[Tt][Ii][Pp]\s*(\d+)$} $MSG -> tip]} {
		# Redirect to specified tip
		return [Http Redir $r "http://www.tcl.tk/cgi-bin/tct/tip/$tip"]
	    } elseif {[regexp {^\s*/[Bb][Uu][Gg]\s*(\d+)$} $MSG -> bug]} {
		# Redirect to specified bug
		return [Http Redir $r "http://sourceforge.net/support/tracker.php?aid=$bug"]
	    } elseif {[regexp {^\s*/[Ww][Ii][Kk][Ii]\s*(.+)$} $MSG -> page]} {
		# Redirect to wiki
		return [Http Redir $r "http://wiki.tcl.tk/$page"]
	    } elseif {[regexp {^\s*/[Aa][Ff][Kk]\s*(.*)$} $MSG -> reason]} {
		# Away
		::/presence $NICK away $reason
	    } elseif {[regexp {^\s*/[Xx][Aa]\s*(.*)$} $MSG -> reason]} {
		# Extended Away
		::/presence $NICK xa $reason
	    } elseif {[regexp {^\s*/[Dd][Nn][Dd]\s*(.*)$} $MSG -> reason]} {
		# Do not disturb
		::/presence $NICK dnd $reason
	    } elseif {[regexp {^\s*/[Bb][Aa][Cc][Kk]\s*(.*)$} $MSG -> reason]} {
		# Back
		::/presence $NICK online $reason
	    } else {
		if {[regexp {^/[Mm][Ee] (.+)} $MSG -> action]} {
		    ::/post $NICK "/me $action"
		} elseif {[regexp {^/[Mm][Ss][Gg] (\w+) (.*)$} $MSG -> privnick privmsg]} {
		    ::/post $NICK $privmsg $privnick
		    set privmsg "Private message to $privnick: $privmsg"
		    lappend log([prep_username $NICK]) [incr logid] [clock seconds] $aNICK $aNICK $privmsg "[armour $privmsg]<br />" "[hfrmt $privmsg]<br />" 0 0 chat
		} else {
		    ::/post $NICK $MSG
		}
		set log([prep_username $NICK]) [lrange $log([prep_username $NICK]) end-[expr {$wubchain_nposts*10-1}] end]
		incr stats(posts_from_wubchain)
		set stats(last_post_time_stamp) [clock seconds]
		resume_suspended
	    }
	}
	# Redirect
	return [Http Redir $r "/wubchain/get#end" SID $SID ID $ID]
    }

    proc /in { r SID ID MSG IN } {
	variable suspended
	variable logid

	set d [dbLoadUser sid $SID]
	if {![string length $SID] || ![dict exists $d username]} {
	    set R ""
	    append R "0" "(id)\n"
	    return [sendPage $r $R 0 0 0]
	}

	if { ![string is integer -strict $ID] } { set ID 0 }
	if {$ID >=$logid} {
	    lappend suspended $r [clock seconds] $SID $ID $MSG
	    return [Http Suspend $r]
	} else {
	    return [/get $r $SID $ID $MSG 1]
	}
    }

    proc /getn { r SID N } {
	variable wubchain_nposts
	if {[catch {check_sid r $SID} d]} { return $r }
	if {$N eq "full"} {
	    set N $wubchain_nposts
	} elseif {![string is integer -strict $N]} {
	    set N 20
	}
	dbUpdate [dict get $d username] lines $N
	return [Http Redir $r "/wubchain/get#end" SID $SID]
    }

    proc /get { r SID ID MSG IN } {
	variable log
	variable logid
	variable stats
	variable irc_users
	variable jabber_users

	if {[catch {check_sid r $SID} d]} { return $r }

	set NICK [dict get $d username]
	set GR   [dict get $d emoticons]
	set CNT  [dict get $d lines]
	set MOB  [dict get $d mobile]
	set TSP  [dict get $d time_stamps]
	set HLL  [dict get $d hide_logon_logoff]
	set NC   [dict get $d nick_colors]
	set UL   [dict get $d user_list]
	if { ![string is integer -strict $ID] } { set ID 0 }
	if { ![string is integer -strict $IN] } { set IN 0 }

	set sl [dbLoadSubjects $NICK]

	set aNICK [armour $NICK]

	# Message list
	set totn [expr {[llength $log([prep_username $NICK])]/10}]
	set n 0
	set Cl {}
	for {set currn 0} {$currn < $totn} {incr currn} {
	    lassign [lrange $log([prep_username $NICK]) end-[expr {($currn+1)*10-1}] end-[expr {$currn*10}]] id ts nick priv opost post hpost emote logonoff type

#	    puts "$id $ts $nick $priv $opost $post $hpost $emote $logonoff $type"

	    if {!$IN || $id > $ID} {
		if {$HLL && $logonoff} {
		    continue
		}
		set tdclass ""
		switch -exact -- $type {
		    groupchat {
			if {$priv ne "" && $priv ne $NICK} {
			    continue
			}
		    }
		    chat -
		    normal {
			if {$priv ne $NICK} {
			    continue
			}
			set tdclass priv_post
		    }
		    error {
			if {$priv ne $NICK} {
			    continue
			}
			set tdclass error_reply
		    }
		    headline {
			if {$priv ne $NICK} {
			    continue
			}
			set tdclass headline
		    }
		}

		if {$tdclass eq "" } {
		    if { $NICK eq $nick } {
			set tdclass my_post
		    } elseif { [dict get $d nick_colors] && [string first $NICK $post] >= 0 } {
			set tdclass nick_post
		    } else {
			set found 0
			foreach {id subj} $sl {
			    if {[string match -nocase $subj $opost]} {
				set found 1
				break
			    }
			}
			if {$found} {
			    set tdclass "subj_post"
			} else {
			    set tdclass "no_subj_post"
			}
		    }
		}
		
		set img ""
		if {!$IN && $n == 0} {
		    append img "<img src='/bookmark.gif' alt='bookmark' />"
		}
		if {$TSP} {
		    if {[string is integer -strict $ts]} {
			set tz [dict get $d time_zone]
			if {[string length $ts]} {
			    if {[catch {clock format $ts -format %H:%M -timezone $tz} t]} {
				set t "[clock format $ts -format %H:%M]*"
			    }
			} else {
			    set t "[clock format $ts -format %H:%M]*"
			}
			set tss "<b>\[$t\]</b> "
		    } else {
			set tss ""
		    }
		} else {
		    set tss ""
		}
		set tC ""

		if {$NC} {
		    set ncpre "<span class='nick_$nick'>"
		    set ncpost "</span>"
		} else {
		    set ncpre ""
		    set ncpost ""
		}

		if {$MOB} {
		    if {[string length $tdclass]} {
			set bgprep "<span class='$tdclass'>"
			set bgpostp "</span>"
		    } else {
			set bgprep ""
			set bgpostp ""
		    }
		    if {$emote} {
			append tC "$img$tss $ncpre$bgprep<b>* $nick</b> "
		    } else {
			append tC "$img$tss $ncpre$bgprep"
			if {[string length $nick]} {
			    append tC "<b>$nick</b>"
			}
			append tC " $bgpostp$bgprep"
		    }
		} else {
		    if {[string length $tdclass]} {
			set td "<td class='$tdclass'>"
			set td2 "<td colspan='2' class='$tdclass'>"
		    } else {
			set td "<td>"
			set td2 "<td colspan='2'>"
		    }
		    if {!$IN} {
			append tC "<tr>"
		    }
		    append tC "<td>$img</td>"
		    if {$TSP} {
			append tC "<td>$tss</td>"
		    }
		    if {$emote} {
			append tC "$td2$ncpre<b>* $nick</b> "
		    } else {
			append tC "$td"
			if {[string length $nick]} {
			    append tC "$ncpre<b>$nick</b> $ncpost"
			}
			append tC "</td>$td$ncpre"
		    }
		}
		if { $GR } {
		    append tC "$hpost"
		} else {
		    append tC "$post"
		}
		if {$MOB} {
		    append tC "$bgpostp$ncpost\n"
		} else {
		    append tC "$ncpost</td>"
		    if {!$IN} {
			append tC "</tr>"
		    } 
		    append tC "\n"
		}
		lappend Cl $tC
		incr n
		if {$n >= $CNT} {
		    break
		}
	    }
	}
	set mC ""
	foreach l [lreverse $Cl] {
	    append mC $l
	}

	# User list
	set uC ""
	if {(!$MOB && $UL) || ($MOB && $UL==2)} {
	    set Tj {}
	    foreach k [lsort -dictionary [array names jabber_users]] {
		if {$jabber_users($k) ne "offline"} {
		    set sj "<br />"
		    set mode ""
		    if {$GR} {
			set img statuc_online.png
			if {[lsearch {online away dnd xa} $jabber_users($k)] >= 0} {
			    set img status_$jabber_users($k).png
			}
			append sj "<img src='/$img' alt='$jabber_users($k)' />"
		    } else {
			if {$jabber_users($k) ne "online"} {
			    set mode " ($jabber_users($k))"
			}
		    }
		    
		    if {$NC} {
			set ncpre "<span class='nick_$k'>"
			set ncpost "</span>"
		    } else {
			set ncpre ""
			set ncpost ""
		    }

		    append sj "<a class='userlink' onClick='insert_nick(\"[armour $k]\");' href='#end'>$ncpre[armour $k] $mode$ncpost</a>"
		    lappend Tj $sj
		}
	    }
	    set Ti {}
	    foreach k [lsort -dictionary [array names irc_users]] {
		if {$irc_users($k)} {
		    set sj "<br />"
		    if {$GR} {
			append sj "<img src='/status_online.png' alt='online' />"
		    }
		    append sj "[armour $k]"
		    lappend Ti $sj
		}
	    }
	    append uC "<p><b>[expr {[llength $Tj]+[llength $Ti]}] User online</b></p>\n"
	    append uC "<p><b>[llength $Tj] Jabber users</b>\n[join $Tj]</p>\n"
	    append uC "<p><b>[llength $Ti] IRC users</b>\n[join $Ti]</p>\n"
	}

	# Create response contents
	set C ""
	if {$IN} {
	    if {!$MOB} {
		if {$UL} {
		    append C "$logid" "(id)\n" $uC "(ircandjabberusers)\n" $mC
		} else {
		    append C "$logid" "(id)\n" $mC
		}
	    }
	} elseif {$MOB} {
	    if {$UL} {
		append C "<div id='umobmsgs'>" 
		append C $mC
		append C "<p><a id='end'></a></p>"
		append C "<div id='mobcontrols'>"
		append C [hform $r $d $SID "" 1 [dict get $d mobile]]
		append C "</div>"
		append C "</div>"
		append C "<div id='wusers'>\n"
		append C "<div id='users'>\n"
		append C $uC
		append C "</div></div>\n"
		append C "</div>\n"
	    } else {
		append C "<div id='mobmsgs'>" 
		append C $mC
		append C "<p><a id='end'></a></p>"
		append C "<div id='mobcontrols'>"
		append C [hform $r $d $SID "" 1 [dict get $d mobile]]
		append C "</div>"
		append C "</div>"
	    }
	} else {
	    if {$UL} {
		append C "<div id='wrap'>"
		append C "<div id='umsgs'>"
		append C "<table id='msgstbl' summary=''>"
		append C $mC
		append C "</table>"
		append C "<p><a id='end'></a></p>"
		append C "<div id='controls'>"
		append C [hform $r $d $SID "" 1 [dict get $d mobile]]
		append C "</div>"
		append C "</div>"
		append C "<div id='wusers'>\n"
		append C "<div id='users'>\n"
		append C $uC
		append C "</div></div>\n"
		append C "</div>\n"
	    } else {
		append C "<div id='wrap'>"
		append C "<div id='msgs'>"
		append C "<table id='msgstbl' summary=''>"
		append C $mC
		append C "</table>"
		append C "<p><a id='end'></a></p>"
		append C "<div id='controls'>"
		append C [hform $r $d $SID "" 1 [dict get $d mobile]]
		append C "</div>"
		append C "</div>"
		append C "</div>\n"
	    }
	}

	# Create response
	incr stats(gets_from_wubchain)
	return [sendPage $r $C 1 $IN [dict get $d mobile]]
    }

    proc dbOpen {fnm} { 
	variable db
	set db wdb
	mk::file open $db $fnm
	# Reset all sid's
	set il [mk::select $db.users]
	foreach i $il {
	    mk::set $db.users!$i sid ""
	}
	mk::file commit $db
	return
    }

    proc dbLoadUser {tag val} { 
	variable db
	set il [mk::select $db.users -exact $tag $val]
	if {[llength $il] != 1} {
	    return [dict create]
	}
	return [dict create {*}[mk::get $db.users![lindex $il 0]]]
    }

    proc dbCheckPreparedUser {username} { 
	variable db
	set pusername [prep_username $username]
	set il [mk::select $db.users]
	foreach i $il {
	    set u [mk::get $db.users!$i username]
	    if {[prep_username $u] eq $pusername} {
		return 0
	    }
	}
	return 1
    }

    proc dbLoadSubjects {username} {
	variable db
	set il [mk::select $db.users -exact username $username]
	if {[llength $il] != 1} {
	    return {}
	}
	set ui [lindex $il 0]
	set sl {}
	foreach si [mk::select $db.users!$ui.subjects] {
	    lappend sl {*}[mk::get $db.users!$ui.subjects!$si id subject]
	}
	return $sl
    }

    proc dbGetSubject {sid id} {
	variable db
	set il [mk::select $db.users -exact sid $sid]
	if {[llength $il] != 1} {
	    return {}
	}
	set ui [lindex $il 0]
	set sl [mk::select $db.users!$ui.subjects -exact id $id]
	if {[llength $sl] != 1} {
	    return
	}
	set si [lindex $sl 0]
	return [mk::get $db.users!$ui.subjects!$si subject]
    }

    proc dbAddSubject {username subject} {
	variable db
	set il [mk::select $db.users -exact username $username]
	if {[llength $il] != 1} {
	    return
	}
	set ui [lindex $il 0]
	set id [llength [mk::select $db.users!$ui.subjects]]
	mk::row append $db.users!$ui.subjects id $id subject $subject
	mk::file commit $db
    }

    proc dbUpdateSubject {username id newsubject} {
	variable db
	set il [mk::select $db.users -exact username $username]
	if {[llength $il] != 1} {
	    return
	}
	set ui [lindex $il 0]
	set sl [mk::select $db.users!$ui.subjects -exact id $id]
	if {[llength $sl] != 1} {
	    return
	}
	set si [lindex $sl 0]
	mk::set $db.users!$ui.subjects!$si subject $newsubject
	mk::file commit $db
    }

    proc dbRemoveSubject {username id} {
	variable db
	set il [mk::select $db.users -exact username $username]
	if {[llength $il] != 1} {
	    return
	}
	set ui [lindex $il 0]
	set sl [mk::select $db.users!$ui.subjects -exact id $id]
	if {[llength $sl] != 1} {
	    return
	}
	set si [lindex $sl 0]
	mk::row delete $db.users!$ui.subjects!$si
	mk::file commit $db
    }

    proc dbAdd {args} {
	variable db
	mk::row append $db.users {*}$args
	mk::file commit $db
	return
    }

    proc dbUsers { } {
	variable db
	set il [mk::select $db.users]
	foreach i $il {
	    lappend l [dict create {*}[mk::get $db.users!$i]]
	}
	return $l
    }
    
    proc dbUpdate {username args} {
	variable db
	set il [mk::select $db.users -exact username $username]
	if {[llength $il] != 1} {
	    return
	}
	mk::set $db.users![lindex $il 0] {*}$args
	mk::file commit $db
	return
    }

    proc dbRemoveUser {username} {
	variable db
	set il [mk::select $db.users -exact username $username]
	if {[llength $il] != 1} {
	    return
	}    
	set sl [dbLoadSubjects $username]
	foreach {subj_id subj_string} [dbLoadSubjects $username] {
	    dbRemoveSubject $username $subj_id
	}
	mk::row delete $db.users![lindex $il 0]
	mk::file commit $db
	return	
    }

    proc dbUniqueSid {sid} {
	variable db
	set il [mk::select $db.users -exact sid $sid]
	return [expr {[llength $il] == 0}]
    }

    proc user_list {} {
	variable db
	set il [mk::select $db.users]
	set l {}
	foreach i $il {
	    set d [dict create {*}[mk::get $db.users!$i]]
	    if {[string length [dict get $d sid]]} {
		lappend l [dict get $d username]
	    }
	}
	return $l	
    }

    proc whois {nick} {
	variable db
	set il [mk::select $db.users -exact username $nick]
	if {[llength $il] == 1} {
	    set d [dict create {*}[mk::get $db.users![lindex $il 0]]]
	    set R "Nick: [dict get $d username]\n"
	    append R "Status: "
	    if {[string length [dict get $d sid]]} {
		append R "Status: is signed on as account [dict get $d username]\n"
	    } else {
		append R "Status: currently not signed on\n"
	    }
	    return $R
	}
	return "No such nick/channel"
    } 

    proc check_sid { rnm SID {admin 0}} { 
	upvar $rnm r
	set d [dbLoadUser sid $SID]
	if {![string length $SID] || ![dict exists $d username]} {
	    set R "Failed to load user data: invalid session-id. You need to <a href='/wubchain/login'>Login</a>."
	    set r [sendPage $r $R 0 0 0]
	    return -code error "invalid session-id"
	}
	if {$admin && ![dict get $d admin]} {
	    set R "You need admin privilege to access this page. "
	    append R [<a> href /wubchain/get?SID=$SID "Back to chat."]
	    set r [sendPage $r $R 0 0 0]
	    return -code error "no admin privilege"
	}
	return $d
    }

    proc /login { r } {
	variable wubchain_admin
	set R "<h1>Login for wubchain</h1>"
	append R "<form id='cpost' action='/wubchain/login/post' method='get'>"
	append R "<table summary=''>"
	append R "<tr><td>Nick: </td><td><input id='username' name='U' size='20' value='' /></td></tr>"
	append R "<tr><td>Password: </td><td><input id='password' type='password' name='P' size='20' value='' /></td></tr>"
	append R "</table>"
	append R "<p><input id='gobutton' type='submit' value='Login' /></p>"
	append R "</form>"
	append R "<p><br /><br />If you don't have a login yet, you can " [<a> href /wubchain/create create] " one or contact <i>$wubchain_admin</i>.</p>"
	append R [help 0 1]
	set r [sortable $r]	;# include the sortable js
	return [sendPage $r $R 0 0 0]
    }

    proc /login/post { r U P } {
	variable log
	variable logid
	variable user_online
	variable jabber_users
	set U [string trim [unescape $U]]
	set P [string trim [unescape $P]]
	if {[string trim $U] eq ""} {
	    set R "Login failed: invalid username."
	    return [sendPage $r $R 0 0 0]
	} 
	if {[string trim $P] eq ""} {
	    set R "Login failed: invalid password."
	    return [sendPage $r $R 0 0 0]
	}
	set ufound 0
	set found 0

	set d [dbLoadUser username $U]
	if {![dict exists $d username]} {
	    set R "Login failed: invalid username."
	    return [sendPage $r $R 0 0 0]
	}
	
	if {[dict get $d password] ne $P} {
	    set R "Login failed: invalid password"
	    return [sendPage $r $R 0 0 0]
	}
	 
	if {[dict get $d state] eq "blocked"} {
	    set R "Login failed: access has been blocked."
	    return [sendPage $r $R 0 0 0]
	}

	while {1} {
	    set sid [format %08x%08x%08x%08x [expr int(rand()*0xffffffff)] [expr int(rand()*0xffffffff)] [expr int(rand()*0xffffffff)] [expr int(rand()*0xffffffff)]]
	    if {[dbUniqueSid $sid]} {
		break
	    }
	}

	if {$::connectToJabber} {
	    /part [dict get $d username]
	}
	dbUpdate $U sid $sid last_login [clock seconds]
	load_history [dict get $d username]
	if {$::connectToJabber} {
	    /join [dict get $d username]
	    ::/post [dict get $d username] names ijchain
	}
        set jabber_users([dict get $d username]) online
	return [Http Redir $r "/wubchain/get#end" SID $sid]
    }

    proc /settings {r SID} {
	if {[catch {check_sid r $SID} d]} { return $r }
	set C ""
	append C [<h1> "Wubchain settings for user '[dict get $d username]'"]
	append C [<h2> "Settings:"]
	append C "<form id='cpost' action='/wubchain/settings/post' method='get'><table summary=''>"
	append C "<tr><td><b>Email address: </b></td><td><input id='email' name='EM' size='40' value='[dict get $d email]' /></td></tr>"
	append C "<tr><td><b>Number of lines to display: </b></td><td><input id='ccnt' name='CNT' size='10' value='[dict get $d lines]' /></td></tr>"
	append C "<tr><td><b>Use emoticons and detect URLs: </b></td><td><input type='checkbox' id='cgr' name='GR' value='1'"
	if {[dict get $d emoticons]} {
	    append C " checked='checked'" 
	}
	append C " /></td></tr>"
	append C "<tr><td><b>Color posts using colors set in TkChat: </b></td><td><input type='checkbox' id='pcl' name='CN' value='1'"
	if {[dict get $d nick_colors]} {
	    append C " checked='checked'" 
	}
	append C " /></td></tr>"
	append C "<tr><td><b>Auto-update: </b></td><td><input type='checkbox' id='cau' name='AU' value='1'"
	if {[dict get $d auto_update]} {
	    append C " checked='checked'" 
	}
	append C " /></td></tr>"
	append C "<tr><td><b>Show connected users: </b></td><td><input type='radio' id='cul0' name='UL' value='0'"
	if {[dict get $d user_list] == 0} {
	    append C " checked='checked'" 
	}
	append C " /> Never</td></tr>"
	append C "<tr><td></td><td><input type='radio' id='cul1' name='UL' value='1'"
	if {[dict get $d user_list] == 1} {
	    append C " checked='checked'" 
	}
	append C " /> In non-mobile view only</td></tr>"
	append C "<tr><td></td><td><input type='radio' id='cul2' name='UL' value='2'"
	if {[dict get $d user_list] == 2} {
	    append C " checked='checked'" 
	}
	append C " /> In mobile and non-mobile view</td></tr>"
	append C "<tr><td><b>Mobile interface: </b></td><td><input type='checkbox' id='cmb' name='MOB' value='1'"
	if {[dict get $d mobile]} {
	    append C " checked='checked'" 
	}
	append C " /></td></tr>"
	append C "<tr><td><b>Default <i>from</i> language: </b></td><td>"
	append C [select_lang SL [dict get $d from_language]]
	append C "</td></tr>"	
	append C "<tr><td><b>Default <i>to</i> language: </b></td><td>"
	append C [select_lang TL [dict get $d to_language]]
	append C "</td></tr>"	
	append C "<tr><td><b>Show timestamps: </b></td><td><input type='checkbox' id='cts' name='TS' value='1'"
	if {[dict get $d time_stamps]} {
	    append C " checked='checked'" 
	}
	append C " /></td></tr>"
	append C "<tr><td><b>Time zone: </b></td><td>"
	append C [select_TZ TZ [dict get $d time_zone]]
	append C "</td></tr>"	
	append C "<tr><td><b>Hide logon/logoff messages: </b></td><td><input type='checkbox' id='cll' name='LOO' value='1'"
	if {[dict get $d hide_logon_logoff]} {
	    append C " checked='checked'" 
	}
	append C " /></td></tr>"
	append C "</table><div>"
	append C "<input id='sid' type='hidden' name='SID' value='$SID' />"
	append C "<input name='gobutton' id='gobutton' type='submit' value='Save settings' />"
	append C "</div></form>"
	append C [<h2> "Subjects:"]
	set sl [dbLoadSubjects [dict get $d username]]
	if {[llength $sl]} {
	    foreach {id s} $sl {
		dict set td [incr i] [dict create subject $s edit [<a> href /wubchain/editsubject?SID=$SID&S=$id "Edit"] remove [<a> href /wubchain/removesubject?SID=$SID&S=$id "Remove"]]
	    }
	    append C [Html dict2table $td {subject edit remove}]
	}
	append C [<a> href /wubchain/addsubject?SID=$SID "Add subject"]
	append C [<h2> "Links:"]
	append C <ul>
	append C [<li> [<a> href /wubchain/logout?SID=$SID "Log-out"]]
	append C [<li> [<a> href /wubchain/clogin?SID=$SID "Change password"]]
	if {[dict get $d admin]} {
	    append C [<li> [<a> href /wubchain/admin?SID=$SID "Admin"]]
	}
	append C [<li> [<a> href /introspect?SID=$SID "Introspection of Wubchain server"]]
	append C [<li> [<a> href /wubchain/get?SID=$SID "Back to chat"]]
	append C </ul>
	set r [sortable $r]
	return [sendPage $r $C 0 0 0]
    }

    proc /settings/post {r SID EM CNT GR CN AU UL MOB SL TL TZ TS LOO} {
	if {[catch {check_sid r $SID} d]} { return $r }

	if { ![string is integer -strict $CNT] } { set CNT 30 }
	if { ![string is integer -strict $GR] } { set GR 0 }
	if { ![string is integer -strict $CN] } { set CN 0 }
	if { ![string is integer -strict $AU] } { set AU 0 }
	if { ![string is integer -strict $UL] } { set UL 0 }
	if { ![string is integer -strict $MOB] } { set MOB 0 }
	if { ![string is integer -strict $TS] } { set TS 0 }
	if { ![string is integer -strict $LOO] } { set LOO 0 }
	if { ![string length $SL] } { set SL en }
	if { ![string length $TL] } { set TL en }

	dbUpdate [dict get $d username] email $EM emoticons $GR nick_colors $CN lines $CNT auto_update $AU user_list $UL mobile $MOB from_language $SL to_language $TL time_stamps $TS time_zone $TZ hide_logon_logoff $LOO

	return [Http Redir $r "/wubchain/get#end" SID $SID]
    }

    proc /addsubject {r SID } { 
	if {[catch {check_sid r $SID} d]} { return $r }
	set C ""
	append C [<h1> "Add subject for user '[dict get $d username]'"]
	append C "<form id='cpost' action='/wubchain/addsubject/post' method='get'>"
	append C "New subject specified as <i>string match</i> pattern: <input id='subj' name='S' size='40' />"
	append C "<div>"
	append C "<input id='sid' type='hidden' name='SID' value='$SID' />"
	append C "<input name='gobutton' id='gobutton' type='submit' value='Add subject' />"
	append C "</div></form>"
	return [sendPage $r $C 0 0 0]
    }

    proc /addsubject/post {r SID S} {
	if {[catch {check_sid r $SID} d]} { return $r }
	dbAddSubject [dict get $d username] $S
	return [Http Redir $r "/wubchain/settings" SID $SID]
    }

    proc /editsubject {r SID S} { 
	if {[catch {check_sid r $SID} d]} { return $r }
	set subject [dbGetSubject $SID $S]
	set C ""
	append C [<h1> "Edit subject for user '[dict get $d username]'"]
	append C "<form id='cpost' action='/wubchain/editsubject/post' method='get'>"
	append C "Edit subject specified as <i>string match</i> pattern: <input id='subj' name='NS' size='40' value='[armour $subject]' />"
	append C "<div>"
	append C "<input id='sid' type='hidden' name='SID' value='$SID' />"
	append C "<input id='oldsubject' type='hidden' name='OS' value='$S' />"
	append C "<input name='gobutton' id='gobutton' type='submit' value='Update subject' />"
	append C "</div></form>"
	return [sendPage $r $C 0 0 0]
    }

    proc /editsubject/post {r SID OS NS} {
	if {[catch {check_sid r $SID} d]} { return $r }
	dbUpdateSubject [dict get $d username] $OS $NS
	return [Http Redir $r "/wubchain/settings" SID $SID]
    }

    proc /removesubject {r SID S } { 
	if {[catch {check_sid r $SID} d]} { return $r }
	dbRemoveSubject [dict get $d username] $S
	return [Http Redir $r "/wubchain/settings" SID $SID]
    }

    proc /logout {r SID} {
	variable log
	variable logid
	variable jabber_users
	if {[catch {check_sid r $SID} d]} { return $r }
	dbUpdate [dict get $d username] sid ""
	unset log([prep_username [dict get $d username]])
	/part [dict get $d username]
        set jabber_users([dict get $d username]) offline
	return [Http Redir $r "/wubchain/login"]
    }

    proc /clogin { r SID } {
	if {[catch {check_sid r $SID} d]} { return $r }
	set R "<h1>Change Wubchain password for user '[dict get $d username]'</h1>"
	append R "<form id='cpost' action='/wubchain/clogin/post' method='get'>"
	append R "<table summary=''>"
	append R "<tr><td>Old password: </td><td><input id='password0' type='password' name='P0' size='20' value='' /></td></tr>"
	append R "<tr><td>New password: </td><td><input id='password1' type='password' name='P1' size='20' value='' /></td></tr>"
	append R "<tr><td>New password: </td><td><input id='password2' type='password' name='P2' size='20' value='' /></td></tr>"
	append R "</table>"
	append R "<p><input id='sid' type='hidden' name='SID' value='$SID' />"
	append R "<input id='gobutton' type='submit' value='Change password' /></p>"
	append R "</form>"
	return [sendPage $r $R 0 0 0]
    }

    proc /clogin/post { r SID P0 P1 P2 } {
	if {[catch {check_sid r $SID} d]} { return $r }

	set P0 [string trim [unescape $P0]]
	set P1 [string trim [unescape $P1]]
	set P2 [string trim [unescape $P2]]

	if {[string trim $P0] eq ""} {
	    set R "Login failed: invalid old password."
	    return [sendPage $r $R 0 0 0]
	}
	if {[string trim $P1] eq ""} {
	    set R "Login failed: invalid new password."
	    return [sendPage $r $R 0 0 0]
	}
	if {[string trim $P2] eq ""} {
	    set R "Login failed: invalid new password."
	    return [sendPage $r $R 0 0 0]
	}
	if {$P1 ne $P2} {
	    set R "Login failed: new passwords are not equal."
	    return [sendPage $r $R 0 0 0]
	}
	if {$P0 eq $P1} {
	    set R "Login failed: password did not change."
	    return [sendPage $r $R 0 0 0]
	}
	if {$P0 ne [dict get $d password]} {
	    set R "Login failed: invalid password."
	    return [sendPage $r $R 0 0 0]
	}

	dbUpdate [dict get $d username] password $P1

	return [Http Redir $r "/wubchain/get#end" SID $SID]
    }

    proc help { SID loginscreen } {
	variable IMG
	variable wubchain_nick_css_list
	set H [<h1> "Wubchain help"]
	append H [<h2> "Overview"]
	append H "This is a web interface to the Tcler's chat. It's an alternative to " [<a> href http://wiki.tcl.tk/tkchat target _blank TkChat] " when all you've got is a browser. It's writtin in " [<a> href http://www.tcl.tk target _blank Tcl/Tk] ", uses " [<a> href http://wiki.tcl.tk/wub target _blank Wub] " as web server and " [<a> href http://code.google.com/p/tclxmppd target _blank tclxmppd] " to connect to the " [<b> #tcl] " Jabber channel. Icons are taken from " [<a> href http://wiki.tcl.tk/tkchat target _blank TkChat] " and "  [<a> href http://www.famfamfam.com/lab/icons/silk target _blank famfamfam] ". Source code for wubchain can be found " [<a> href http://code.google.com/p/wubchain target _blank here] "."
	append H "<br /><br />Wubchain has 2 modes:"
	append H <ul>
	append H <li> "Mobile mode:"
	append H <ul>
	append H [<li> "Minimise traffic"]
	append H [<li> "Maximise screen use"]
	append H [<li> "Manual refresh"]
	append H [<li> "Optional color messages according to color set by users in TkChat"]
	append H [<li> "Optional detection of emoticons and URL's"]
	append H [<li> "Optional hiding of log-on / log-off messages"]
	append H [<li> "Optional hiding of time stamps"]
	append H [<li> "Optional list of users connected to the chat, click on a Jabber user to make the message you're typing a private message."]
	append H [<li> "Shortcuts to display full history or last 20 lines."]
	append H </ul></li>
	append H <li> "Full browser mode:"
	append H <ul>
	append H [<li> "Auto-update, works on IE7 and FireFox 2, needs more testing on Safari."]
	append H [<li> "Optional color messages according to color set by users in TkChat."]
	append H [<li> "Optional detection of emoticons and URL's."]
	append H [<li> "Google selected text."]
	append H [<li> "Translate selected text."]
	append H [<li> "Optional hiding of log-on / log-off messages."]
	append H [<li> "Optional timestamps, with adjustable time zone."]
	append H [<li> "Optional list of users connected to the chat, click on a Jabber user to make the message you're typing a private message."]
	append H [<li> "Shortcuts to display full history or last 20 lines."]
	append H </ul></li>
	append H "</ul>"
	append H [<h2> "Reporting errors:"]
	append H "Errors as well as feature request can be reported " [<a> href http://code.google.com/p/wubchain/issues target _blank here] "."
	append H [<h2> "Special commands:"]
	append H "<dl>"
	append H [<dt> "/me [<i> text]"] [<dd> "Send action [<i> text]."]
	append H [<dt> "/msg [<i> nick] [<i> text]"] [<dd> "Send private message [<i> text] to user [<i> nick]."]
	append H [<dt> "/afk [<i> ?message?]"] [<dd> "Set status indicator to [<i> away], with optional message."]
	append H [<dt> "/xa [<i> ?message?]"] [<dd> "Set status indicator to [<i> {extended away}], with optional message."]
	append H [<dt> "/dnd [<i> ?message?]"] [<dd> "Set status indicator to [<i> {do not disturb}], with optional message."]
	append H [<dt> "/back [<i> ?message?]"] [<dd> "Set status indicator to [<i> online], with optional message."]
	append H [<dt> "/wiki [<i> {page_number or search_string}]"] [<dd> "Go to the Tclers's wiki and open page [<i> {page_number}] or search for [<i> {search_string}]."]
	append H [<dt> "/tip [<i> {tip_number}]"] [<dd> "Open Tcl Improvement Proposal [<i> {tip_number}]."]
	append H [<dt> "/bug [<i> {bug_id}]"] [<dd> "Open Source-Forge bug [<i> {bug_id}]."]
	append H "</dl>"
	append H [<h2> "Background colors:"]
	append H <ul>
	append H [<li> [<span> class nick_post "Posts containing your username."]]
	append H [<li> [<span> class my_post "Posts you made youself."]]
	append H [<li> [<span> class priv_post "Private posts sent to you."]]
	append H [<li> [<span> class subj_post "Posts containing a subject you specified."]]
	append H [<li> [<span> class error_reply "Error messages received from Jabber server."]]
	append H [<li> [<span> class headline "Headline messages."]]
	append H "</ul>"
	if {!$loginscreen} {
	    append H [<h2> "Foreground colors:"]
	    append H "Foreground color of posts is set according to color set by poster in TkChat:<br /><br />"
	    append H <table><tr>
	    set cnt 0
	    foreach i [lsort -dictionary -index 0 $wubchain_nick_css_list] {
		lassign $i n c
		if {$c eq "#000000"} continue
		if {$cnt && (($cnt % 5) == 0)} {
		    append H </tr><tr>
		}
		append H [<td> [<span> class $n [armour "[string range $n 5 end] ($c)"]]]
		incr cnt
	    }
	    append H </tr></table>
	}
	append H [<h2> "User status indictators:"]
	append H "<table summary='status indicators'>"
	foreach i {online away xa dnd} txt {Online Away "Extended away" "Do not disturb"} {
	    append H "<tr><td><img src='/status_$i.png' alt='$txt' /></td><td>$txt</td></tr>"
	}
	append H </table>
	append H [<h2> "Emoticons:"]
	set max 0
	foreach k [array names IMG] {
	    lappend img($IMG($k)) $k
	    if {[llength $img($IMG($k))]>$max} {
		set max [llength $img($IMG($k))]
	    }
	}
	foreach k [lsort -dictionary [array names img]] {
	    set ascii ""
	    foreach i [lsort -dictionary $img($k)] {
		append ascii "[armour $i]&nbsp;&nbsp;&nbsp;&nbsp;"
	    }
	    set d [dict create name $k image [make_iref $i] ascii $ascii]
	    dict set td [incr imgi] $d
	}
	append H [Html dict2table $td {name image ascii}]
	if {!$loginscreen} {
	    append H [<a> href /wubchain/get?SID=$SID "Back to chat"]
	}
	return $H
    }


    proc /help { r SID } {
	variable IMG
	variable wubchain_nick_css_list
	if {[catch {check_sid r $SID} d]} { return $r }
	set H [help $SID 0]
	set r [sortable $r]	;# include the sortable js
	return [sendPage $r $H 0 0 0]
    }

    proc /create { r }  {
	set q [expr {int(rand()*100)}]
	set R "<h1>Create Wubchain login</h1>"
	append R "<form id='cpost' action='/wubchain/create/post' method='get'>"
	append R "<table summary=''>"
	append R "<tr><td>Username: </td><td><input id='username' name='U' size='40' value='' /></td></tr>"
	append R "<tr><td>Email-address: </td><td><input id='email' name='E' size='40' value='' /></td></tr>"
	append R "<tr><td>New password: </td><td><input id='password1' type='password' name='P1' size='40' value='' /></td></tr>"
	append R "<tr><td>New password: </td><td><input id='password2' type='password' name='P2' size='40' value='' /></td></tr>"
	append R "<tr><td>Answer to $q % 8: </td><td><input id='answer' name='A' size='40' value='' /></td></tr>"
	append R "</table>"
	append R "<p><input id='q' type='hidden' name='Q' value='$q' /><input id='gobutton' type='submit' value='Create account' /></p>"
	append R "</form>"
	return [sendPage $r $R 0 0 0]
    }

    proc /create/post { r U E P1 P2 Q A } {
	set U [string trim [unescape $U]]
	set E [string trim [unescape $E]]
	set P1 [string trim [unescape $P1]]
	set P2 [string trim [unescape $P2]]
	set Q [string trim [unescape $Q]]
	set A [string trim [unescape $A]]
	if {$U eq ""} {
	    set R "Could not create account: invalid username."
	    return [sendPage $r $R 0 0 0]
	}
	if {$E eq ""} {
	    set R "Could not create account: invalid email-address"
	    return [sendPage $r $R 0 0 0]
	}
	if {$P1 eq ""} {
	    set R "Could not create account: invalid password"
	    return [sendPage $r $R 0 0 0]
	}
	if {$P2 eq ""} {
	    set R "Could not create account: invalid password"
	    return [sendPage $r $R 0 0 0]
	}
	if {$P2 ne $P1} {
	    set R "Could not create account: passwords do not match"
	    return [sendPage $r $R 0 0 0]
	}
	if {![string is integer -strict $Q] || ![string is integer -strict $A] || ($Q%8) != $A} {
	    set R "Could not create account: invalid answer to security question"
	    return [sendPage $r $R 0 0 0]
	}

	if {![dbCheckPreparedUser $U]} {
	    set R "Could not create account: username already in use"
	    return [sendPage $r $R 0 0 0]	    
	}

	set d [dbLoadUser username $U]
	if {[dict exists $d username]} {
	    set R "Could not create account: username already in use"
	    return [sendPage $r $R 0 0 0]
	}

	dbAdd \
	    username $U \
	    password $P1 \
	    email $E \
	    sid "" \
	    last_login 0 \
	    emoticons 1 \
	    nick_colors 1 \
	    lines 30 \
	    auto_update 1 \
            user_list 1 \
	    mobile 0 \
	    from_language en \
	    to_language en \
	    time_stamps 1 \
	    time_zone :GMT \
	    hide_logon_logoff 0 \
	    admin 0 \
	    state ""

	set R ""
	append R "New account was create successfully. " [<a> href /wubchain/login Login] " to access Wubchain."
	return [sendPage $r $R 0 0 0]
    }

    proc /admin {r SID} {
	if {[catch {check_sid r $SID 1} d]} { return $r }
	set R [<h1> "Wubchain Admin"]
	append R [<h2> "Users"]
	foreach ud [dbUsers] {
	    dict set ud last_login [clock format [dict get $ud last_login] -format "%Y-%m-%d %H:%M:%S"]
	    dict set ud details [<a> href /wubchain/admin/details?SID=$SID&U=[Query encode [dict get $ud username]] details]
	    dict set ud remove [<a> href /wubchain/admin/remove?SID=$SID&U=[Query encode [dict get $ud username]] remove]
	    dict set ud block [<a> href /wubchain/admin/block?SID=$SID&U=[Query encode [dict get $ud username]] block]
	    dict set ud unblock [<a> href /wubchain/admin/unblock?SID=$SID&U=[Query encode [dict get $ud username]] unblock]
	    dict set td [incr i] $ud
	}
	if {[info exists td]} {
	    append R [Html dict2table $td {username last_login mobile state admin details block unblock remove}]
	}
	append R [<a> href /wubchain/get?SID=$SID "Back to chat"]
	set r [sortable $r]	;# include the sortable js
	return [sendPage $r $R 0 0 0]
    }

    proc /admin/details {r SID U} {
	if {[catch {check_sid r $SID 1} d]} { return $r }
	set R ""
	set U [encoding convertfrom utf-8 $U]
	append R [<h1> "Details for user '$U':"]
	set ud [dbLoadUser username $U]

	if {[dict exists $ud username]} {
	    foreach k [lsort -dictionary [dict keys $ud]] {
		dict set td [incr i] [dict create key $k value [dict get $ud $k]]
	    }
	    append R [<h2> "Settings:"]
	    if {[info exists td]} {
		append R [Html dict2table $td {key value}]
	    }
	    append R [<h2> "Subjects:"]
	    set sl [dbLoadSubjects [dict get $ud username]]
	    unset -nocomplain td
	    if {[llength $sl]} {
		foreach {id s} $sl {
		    dict set td [incr i] [dict create subject $s]
		}
		append R [Html dict2table $td {subject}]
	    }
	} else {
	    append R "<p>Unknown user</p>"
	}
	append R [<a> href /wubchain/get?SID=$SID "Back to chat"]
	append R " "
	append R [<a> href /wubchain/admin?SID=$SID "Back to admin"]
	set r [sortable $r]	;# include the sortable js
	return [sendPage $r $R 0 0 0]	
    }

    proc /admin/block {r SID U} {
	if {[catch {check_sid r $SID 1} d]} { return $r }
	set U [encoding convertfrom utf-8 $U]
	set ud [dbLoadUser username $U]
	if {[dict exists $ud state]} {
	    dbUpdate $U state blocked sid ""
	}
	return [Http Redir $r "/wubchain/admin" SID $SID]
    }

    proc /admin/unblock {r SID U} {
	if {[catch {check_sid r $SID 1} d]} { return $r }
	set U [encoding convertfrom utf-8 $U]
	set ud [dbLoadUser username $U]
	if {[dict exists $ud state] && [dict get $ud state] eq "blocked"} {
	    dbUpdate $U state ""
	}
	return [Http Redir $r "/wubchain/admin" SID $SID]
    }

    proc /admin/remove {r SID U} {
	if {[catch {check_sid r $SID 1} d]} { return $r }
	set U [encoding convertfrom utf-8 $U]
	set ud [dbLoadUser username $U]
	if {[dict exists $ud username]} {
	    dbRemoveUser $U
	}
	return [Http Redir $r "/wubchain/admin" SID $SID]
    }

    proc tzd { dir {pfx ""} } { 
	variable tzdl
	foreach f [glob -nocomplain -tail -type f -directory $dir *] {
	    lappend tzdl :$pfx$f
	}
    }

    proc collect_TZ {} {
	variable tzdl {}
	tzd $::tcl_library/tzdata
	foreach d [glob -nocomplain -type d -directory $::tcl_library/tzdata *] {
	    tzd $d [file tail $d]/
	}
	set tzdl [lsort -dictionary $tzdl]
	set tzdl {}
	if {![llength $tzdl]} {
	    set f [open tzd.dat r]
	    set tzdl [split [read $f] \n]
	    close $f
	}
    }
}

Direct init wubchain namespace ::Wubchain prefix /wubchain/

# Responder::post - postprocess response by converting
proc Responder::post {rsp} {
    return [::Convert do $rsp]
}

proc Responder::do {req} {

#    puts [dict get $req -path]

    switch -glob -- [dict get $req -path] {

	/ {
	    Http Redir $req "/wubchain/login"
	}

	/*.php -
	/*.wmv -
	/*.exe -
	/*.gz -
	/cgi-bin/* {
	    # attempted access to non-existent files indicates a malicious bot
	    # block the originator by IP
	    Block block [dict get $req -ipaddr] "Bogus URL '[dict get $req -path]'"
	    Send [Http Forbidden $req]
	    continue	;# process next request, this one's dealt with
	}

	/wubchain/* -
	/wubchain {
	    ::wubchain do $req
	}

	/introspect/* -
	/introspect {
	    ::introspect do $req
	}

	/*.jpg -
	/*.gif -
	/*.png -
	/favicon.ico {
	    # silently redirect image files - strip all but tail
	    dict set req -suffix [file tail [dict get $req -path]]
	    ::images do $req
	}
	
	/css/*.css -
	/*.css {
	    # silently redirect css files
	    dict set req -suffix [file tail [dict get $req -path]]
	    ::css do $req
	}

	/robots.txt {
	    Http Ok $req "User-agent: *\nDisallow: /" text/plain
	}

	/*.js {
	    # silently redirect js files
	    dict set req -suffix [file tail [dict get $req -path]]
	    ::scripts do $req
	}

	default {
	    Http NotFound $req
	}
    }
}

proc Incoming {req} { return [Responder Process $req] }

expr srand([clock seconds]) ;# set rand seed for session-id generation

Wubchain::dbOpen $wubchainDb
Wubchain::collect_TZ

proc every {ms body} {after $ms [info level 0]; eval $body}

# Create css
every [expr {$::Wubchain::wubchain_nick_css_update_interval*1007}] Wubchain::create_nick_css
every [expr {$::Wubchain::wubchain_suspend_timeout*1000}] [list Wubchain::resume_suspended 1]

Debug off http 20
Debug off socket 10
Debug off direct 10
Debug off cache 10

# Start jabber component
if {$::connectToJabber} {
    ::component::Main
}

# Start Site Server(s)
Site start docroot $docroot home $docroot listener {-port 30008} https {-port -1} scgi {-port 0} cmdport 30012
